home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / x68000.arc / SOURCE.ARC / SRECORD.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-01-23  |  8.0 KB  |  283 lines
  1. IMPLEMENTATION MODULE Srecord;
  2. (* Creates Motorola S-records of program:        *)
  3. (*    S0 = header record,                        *)
  4. (*    S2 = code/data records (24 bit address),   *)
  5. (*    S8 = termination record (24 bit address).  *)
  6.  
  7.    FROM FileSystem IMPORT
  8.       File, WriteChar;
  9.  
  10.    FROM Strings IMPORT
  11.       Length;
  12.  
  13.    FROM LongNumbers IMPORT
  14.       LONG, LongAdd, LongSub, LongInc, LongDec, LongClear, 
  15.       LongCompare, CardToLong, LongPut;
  16.  
  17.    IMPORT ASCII;
  18.  
  19.  
  20.    CONST
  21.       CountMAX = 16;
  22.       SrecMAX = CountMAX * 2;
  23.       XrecMAX = SrecMAX;
  24.  
  25.  
  26.    VAR
  27.       StartAddr : LONG;   (* address that record starts on *)
  28.       TempAddr : LONG;    (* running address of where we are now *)
  29.       CheckSum : LONG;
  30.       Count : CARDINAL;   (* count of HEX-pairs in S-record *)
  31.       Sdata : ARRAY [1..SrecMAX] OF INTEGER;   (* S-record data, HEX digits *)
  32.       Sindex : CARDINAL;   (* index for Sdata array *)
  33.       Xdata : ARRAY [1..XrecMAX] OF INTEGER;   (* Overflow for Sdata *)
  34.       Xindex : CARDINAL;   (* index for Xdata array *)
  35.       Boundary : BOOLEAN;   (* marks Address MOD 16 boundary of S-record *)
  36.       LZero : LONG;   (* used as a constant = 0 *)
  37.  
  38.  
  39.  
  40.    PROCEDURE Complement;   (* CheckSum *)
  41.       BEGIN
  42.          LongSub (LZero, CheckSum, CheckSum);   (* 2's Complement *)
  43.          LongDec (CheckSum, 1);   (* Make it 1's Complement *)
  44.       END Complement;
  45.  
  46.  
  47.       
  48.    PROCEDURE AppendSdata (Data : LONG; n : CARDINAL) : BOOLEAN;
  49.    (* Transfers data to Sdata, and updates Count & CheckSum. *)
  50.    (*    If no room: Data goes to Xdata & FALSE returned.    *)
  51.  
  52.       VAR
  53.          T : LONG;   (* temporary -- used only as a 2 digit HEX number *)
  54.  
  55.       BEGIN
  56.          T := LZero;
  57.  
  58.          WHILE (n # 0) AND (Count # CountMAX) AND (NOT Boundary) DO
  59.             Sdata[Sindex] := Data[n];
  60.             Sdata[Sindex - 1] := Data[n - 1];
  61.  
  62.             T[2] := Data[n];   T[1] := Data[n - 1];
  63.             LongAdd (T, CheckSum, CheckSum);
  64.  
  65.             DEC (n, 2);
  66.             DEC (Sindex, 2);
  67.             INC (Count);
  68.  
  69.             LongInc (TempAddr, 1);
  70.             IF TempAddr[1] = 0 THEN   (* i.e., TempAddr MOD 16 = 0 *)
  71.                Boundary := TRUE;
  72.             END;
  73.          END;
  74.    
  75.          IF (Count = CountMAX) OR (Boundary) THEN
  76.             WHILE n > 0 DO   (* Add Data to Xdata (in reverse) *)
  77.                INC (Xindex);
  78.                Xdata[Xindex] := Data[n];
  79.                DEC (n);
  80.             END;
  81.  
  82.             RETURN FALSE;   (* Sdata is full *)
  83.          ELSE
  84.             RETURN TRUE;
  85.          END;         
  86.       END AppendSdata;
  87.  
  88.  
  89.  
  90.    PROCEDURE DumpSdata (VAR f : File);
  91.    (* Writes an S2 record to the file *)
  92.       
  93.       VAR
  94.          T : LONG;   (* temporary -- used to output Count & CheckSum *)
  95.          i, j : CARDINAL;
  96.  
  97.       BEGIN
  98.          IF Count = 0 THEN
  99.             RETURN;   (* nothing to dump *)
  100.          END;
  101.  
  102.          WriteChar (f, 'S');
  103.          WriteChar (f, '2');
  104.          
  105.          CardToLong (Count + 4, T);   (* extra for Address & Checksum *)
  106.          LongPut (f, T, 2);
  107.          LongAdd (T, CheckSum, CheckSum);   (* Add Count to CheckSum *)
  108.  
  109.          LongPut (f, StartAddr, 6);
  110.          (* Add Address to CheckSum *)
  111.          T := LZero;
  112.          T[1] := StartAddr[1];   T[2] := StartAddr[2];
  113.          LongAdd (T, CheckSum, CheckSum);
  114.          T[1] := StartAddr[3];   T[2] := StartAddr[4];
  115.          LongAdd (T, CheckSum, CheckSum);
  116.          T[1] := StartAddr[5];   T[2] := StartAddr[6];
  117.          LongAdd (T, CheckSum, CheckSum);
  118.          
  119.          IF Count < CountMAX THEN   (* adjust short record -- shuffle down *)
  120.             j := 1;
  121.             FOR i := Sindex + 1 TO SrecMAX DO
  122.                Sdata[j] := Sdata[i];
  123.                INC (j);
  124.             END;
  125.          END;
  126.          LongPut (f, Sdata, Count * 2);   (* S-record Code/Data *)
  127.  
  128.          Complement; (* CheckSum *)
  129.          LongPut (f, CheckSum, 2);
  130.  
  131.          WriteChar (f, ASCII.cr);
  132.          WriteChar (f, ASCII.lf);
  133.  
  134.          LongInc (StartAddr, Count);
  135.          Sindex := SrecMAX;
  136.          Count := 0;
  137.          Boundary := FALSE;
  138.          CheckSum := LZero;
  139.       END DumpSdata;
  140.  
  141.  
  142.  
  143.    PROCEDURE GetXdata;
  144.    (* Transfer Xdata into new Sdata line -- N.B.: Xdata stored in reverse *)
  145.  
  146.       VAR
  147.          i : CARDINAL;
  148.          T : LONG;
  149.  
  150.       BEGIN
  151.          i := 1;
  152.          T := LZero;
  153.  
  154.          (* No need for either of the tests (CountMAX or Boundary)   *)
  155.          (* used in AppendSdata.  GetXdata is only ever called       *)
  156.          (* after DumpSdata and is therefore only putting (up to 20) *)
  157.          (* HEX digits in an empty buffer (which could hold 32).     *)
  158.          WHILE i < Xindex DO
  159.             Sdata[Sindex] := Xdata[i];   
  160.             Sdata[Sindex - 1] := Xdata[i + 1];
  161.             T[2] := Sdata[Sindex];   T[1] := Sdata[Sindex - 1];   
  162.             LongAdd (T, CheckSum, CheckSum);
  163.             INC (i, 2);
  164.             DEC (Sindex, 2);
  165.             INC (Count);
  166.             LongInc (TempAddr, 1);
  167.          END;
  168.  
  169.          Xindex := 0;            
  170.       END GetXdata;
  171.  
  172.  
  173.  
  174.    PROCEDURE StartSrec (VAR f : File; SourceFN : ARRAY OF CHAR);
  175.    (* Writes S0 record (HEADER) and initializes *)
  176.       
  177.       VAR
  178.          T : LONG;   (* temporary *)
  179.          i : CARDINAL;
  180.  
  181.       BEGIN
  182.          WriteChar (f, 'S');
  183.          WriteChar (f, '0');
  184.  
  185.          CheckSum := LZero;
  186.          Count := Length (SourceFN) + 3;   (* extra for Address & Checksum *)
  187.          CardToLong (Count, T);
  188.          LongPut (f, T, 2);
  189.          LongAdd (T, CheckSum, CheckSum);
  190.          
  191.          LongPut (f, LZero, 4);   (* Address is 4 digit, all zero, for S0 *)
  192.  
  193.          i := 0;
  194.          WHILE SourceFN[i] # 0C DO
  195.             CardToLong (ORD (SourceFN[i]), T);
  196.             LongAdd (T, CheckSum, CheckSum);
  197.             LongPut (f, T, 2);
  198.             INC (i);
  199.          END;
  200.          
  201.          Complement;   (* CheckSum *)
  202.          LongPut (f, CheckSum, 2);
  203.  
  204.          WriteChar (f, ASCII.cr);
  205.          WriteChar (f, ASCII.lf);
  206.  
  207.          Sindex := SrecMAX;
  208.          Xindex := 0;
  209.          Count := 0;
  210.          Boundary := FALSE;
  211.          CheckSum := LZero;
  212.          StartAddr := LZero;
  213.          TempAddr := LZero;
  214.       END StartSrec;
  215.  
  216.  
  217.  
  218.    PROCEDURE WriteSrecLine (VAR f : File; 
  219.                             AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
  220.                                nA,     nO,    nS,     nD    : CARDINAL);
  221.    (* Collects Object Code -- Writes an S2 record to file if line is full *)
  222.  
  223.       VAR
  224.          dummy : BOOLEAN;
  225.       
  226.       BEGIN
  227.          IF nA = 0 THEN
  228.             RETURN;   (* Nothing to add to S-record *)
  229.          END;
  230.  
  231.          IF Xindex # 0 THEN
  232.             GetXdata;   (* transfers Xdata into Sdata *)
  233.          END;
  234.  
  235.          IF LongCompare (AddrCnt, TempAddr) # 0 THEN
  236.             DumpSdata (f);
  237.          END;
  238.  
  239.          IF Count = 0 THEN
  240.             StartAddr := AddrCnt;
  241.             TempAddr := AddrCnt;
  242.          END;
  243.       
  244.          dummy := AppendSdata (ObjOp, nO);
  245.          dummy := AppendSdata (ObjSrc, nS);
  246.          IF NOT AppendSdata (ObjDest, nD) THEN
  247.             DumpSdata (f);
  248.          END;
  249.       END WriteSrecLine;
  250.  
  251.  
  252.  
  253.    PROCEDURE EndSrec (VAR f : File);
  254.    (* Finishes off any left-over (Partial) S2 line, *)
  255.    (* and then writes S8 record (TRAILER)           *)
  256.       BEGIN
  257.          IF Xindex # 0 THEN
  258.             GetXdata;
  259.          END;
  260.          DumpSdata (f);
  261.          
  262.          WriteChar (f, 'S');   (* Fixed format for S8 record *)
  263.          WriteChar (f, '8');
  264.          WriteChar (f, '0');
  265.          WriteChar (f, '4');
  266.          WriteChar (f, '0');
  267.          WriteChar (f, '0');
  268.          WriteChar (f, '0');
  269.          WriteChar (f, '0');
  270.          WriteChar (f, '0');
  271.          WriteChar (f, '0');
  272.          WriteChar (f, 'F');
  273.          WriteChar (f, 'C');
  274.          WriteChar (f, ASCII.cr);
  275.          WriteChar (f, ASCII.lf);
  276.          WriteChar (f, ASCII.cr);
  277.          WriteChar (f, ASCII.lf);
  278.       END EndSrec;
  279.  
  280. BEGIN   (* Initialization *)
  281.    LongClear (LZero);
  282. END Srecord.
  283.